Attribute VB_Name = "shared"
Option Explicit

Public cartRam(8192) As Byte 'Cart RAM.  (8K)
Public cartRom(49152) As Byte 'ROM Pages, 0,1,2 (SaveRAM)
Public frame_two_rom As Long 'Does frame 2 use ROM or SRAM.
Public glMemAddrDiv256(65535) As Long 'Lookup table for speed division.
Public DoGameGearBorder As Boolean 'show the game gear border or not
Public IsGameGear As Boolean 'checks to see if it's a game gear game or not
Public Mul4000() As Long 'Lookup table for * &H4000&
Public number_of_pages As Long 'How many pages exist in a ROM.
Public pages() As Byte 'Holds ROM file data.
Public ROM_Name As String 'holds the rom's name in ram
Public ShiftRight(600, 1 To 10) As Long 'Lookup table for speed ShiftRight.
Public ShiftLeft(600, 1 To 10)  As Long 'Lookup table for speed ShiftLeft.
Public SRAM(16384) As Byte 'Cartridge Ram Page 1 (Save RAM).
Public MemoryEditorOpen As Boolean 'checks if the memory editor is open

Public Const Page1 As Long = &H4000& 'Value For Page 1, (Memory Mapping).
Public Const Page2 As Long = &H8000& 'Value For Page 2, (Memory Mapping).

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal cb As Long)
Public Function fixvalue(a As String) As String 'fixes the addy so it's 2 characters
  If Len(a$) = 1 Then fixvalue = "0" & a$: Exit Function
  fixvalue = a$
End Function
Public Function fixaddress(a As String) As String 'fixes the addy so it's 4 characters
  If Len(a$) = 1 Then fixaddress = "000" & a$: Exit Function
  If Len(a$) = 2 Then fixaddress = "00" & a$: Exit Function
  If Len(a$) = 3 Then fixaddress = "0" & a$: Exit Function
  fixaddress = a$
End Function
Public Function fixbmpfilename(a As String) As String 'fixes the bmp filename for avis so it's 10 characters (keep in order)
  a$ = Replace(a$, " ", "")
  If Len(a$) = 1 Then fixbmpfilename = "000000000" & a$: Exit Function
  If Len(a$) = 2 Then fixbmpfilename = "00000000" & a$: Exit Function
  If Len(a$) = 3 Then fixbmpfilename = "0000000" & a$: Exit Function
  If Len(a$) = 4 Then fixbmpfilename = "000000" & a$: Exit Function
  If Len(a$) = 5 Then fixbmpfilename = "00000" & a$: Exit Function
  If Len(a$) = 6 Then fixbmpfilename = "0000" & a$: Exit Function
  If Len(a$) = 7 Then fixbmpfilename = "000" & a$: Exit Function
  If Len(a$) = 8 Then fixbmpfilename = "00" & a$: Exit Function
  If Len(a$) = 9 Then fixbmpfilename = "0" & a$: Exit Function
  fixbmpfilename = a$
End Function
Public Sub compatibiltyhacks(hash As String)

  'Call InputBox("", "", hash$)

  If hash$ = "BC48365D" Then HACK_Spider = True Else HACK_Spider = False 'spiderman sinister six
  If hash$ = "DF400BEE" Then pages(&H1C12F) = &H0&: pages(&H1C12F + 1) = &H0&: pages(&H1C12F + 2) = &H0& 'hang on/safari hunt bios
  If hash$ = "6A2AA22B" Then pages(&H17EDE) = &H0&: pages(&H17EDE + 1) = &H0&: pages(&H17EDE + 2) = &H0& 'alex kidd in miracle world bios
  If hash$ = "5A9E9435" Then pages(&H26FA) = &H0&: pages(&H26FA + 1) = &H0&: pages(&H26FA + 2) = &H0& 'sonic euro bios
  If hash$ = "C2FF32" Then pages(&HFB5) = &HDD&: pages(&HFB5 + 1) = &H4E&: pages(&HFB5 + 2) = &HFF& '20 em 1
  If hash$ = "8BD837E9" Then pages(&H45D) = &H0&: pages(&H45D + 1) = &H0& 'wanted
  If hash$ = "8E620D1B" Then pages(&H173) = &HC& 'sports pad soccer
  If hash$ = "ED26A448" Then pages(&H5A7) = &HAF&: pages(&H5A7 + 1) = &H0& 'american pro football
  If hash$ = "B343492D" Then pages(&H592) = &HAF&: pages(&H592 + 1) = &H0& 'walter payton
  If hash$ = "A5F1F4DE" Then pages(&H25B) = &H0&: pages(&H25B + 1) = &H0& 'wonder boy 3
  If hash$ = "2894DD55" Then pages(&H25B) = &H0&: pages(&H25B + 1) = &H0& 'monica em o res

End Sub
Public Function fileexists(sFileName As String) As Boolean

  If sFileName$ = "" Then
    fileexists = False
    Exit Function
  End If

  If Len(Dir$(sFileName$)) Then
    fileexists = True
  Else
    fileexists = False
  End If

End Function
Public Function filenameextract(filea As String) As String

  Dim a As String, b As String

  a$ = filea$
  b$ = filea$

  Do
    a$ = left(a$, Len(a$) - 1)
  Loop Until right$(a$, 1) = "\"

  b$ = Mid$(b$, Len(a$) + 1)
  
  If LCase(right(b$, 3)) = ".gg" Then
    a$ = left$(b$, Len(b$) - 3)
  Else
    a$ = left$(b$, Len(b$) - 4)
  End If

  filenameextract$ = a$

End Function
Public Function directoryexists(strDir As String) As Boolean

  On Error Resume Next

  If right$(strDir$, 1) <> "\" Then
    strDir$ = strDir$ & "\"
  End If

  If Dir$(strDir$ & "*.*", vbDirectory) = "" Then
    directoryexists = False
  Else
    directoryexists = True
  End If

End Function

Private Sub Main() 'Program Entry Point.

  Dim X As Long, Y As Long, Z As Long, bytArray(192) As Byte

  Call timeBeginPeriod(1&) 'fixes timing?

  OriginalScreenWidth = Screen.Width / 15
  OriginalScreenHeight = Screen.Height / 15

  Call settingsload

  Call samplerate(CurrentSampleRate)
  
  AVITemp$ = App.Path & "\folders\temporary\avi.bmp"

  frmSMS.mnuBookmarks.Visible = False
  frmSMS.mnuResults.Visible = False
  frmSMS.mnuPAR.Visible = False

  frmSMS.mnuReset.Caption = "&reset" & vbTab & "bkspc"
  frmSMS.mnuPause.Caption = "&pause" & vbTab & "pause/brk"
  frmSMS.mnuFullScreenToggle.Caption = "&toggle" & vbTab & "esc"
  frmSMS.mnuLoadROM.Caption = "&load rom..." & vbTab & "f1"
  frmSMS.mnuCloseROM.Caption = "&close rom" & vbTab & "shift+bkspc"
  frmSMS.mnuStateSave.Caption = "&save" & vbTab & "f5"
  frmSMS.mnuStateLoad.Caption = "&load" & vbTab & "f6"
  frmSMS.mnuMovieRecord.Caption = "&record" & vbTab & "f7"
  frmSMS.mnuMoviePlay.Caption = "&play" & vbTab & "f8"
  frmSMS.mnuAdvanceFrame.Caption = "&advance frame" & vbTab & "f11"
  frmSMS.mnuSaveScreenshot.Caption = "&save screenshot" & vbTab & "f12"
  frmSMS.mnuLayerBG.Caption = "&show background" & vbTab & "f9"
  frmSMS.mnuLayerSprites.Caption = "&show sprites" & vbTab & "f10"
  frmSMS.mnuAVIRecord.Caption = "&record avi movie..." & vbTab & "shift+f7"
  frmSMS.mnuFastForward.Caption = "&fast forward" & vbTab & "shift+f11"

  Call vdp.loadpalette 'load palette
  
  If directoryexists(App.Path & "\folders") = False Then Call MkDir(App.Path & "\folders") 'make folders directory
  If directoryexists(App.Path & "\folders\save states") = False Then Call MkDir(App.Path & "\folders\save states") 'make states directory
  If directoryexists(App.Path & "\folders\movie states") = False Then Call MkDir(App.Path & "\folders\movie states") 'make movies directory
  If directoryexists(App.Path & "\folders\screenshots") = False Then Call MkDir(App.Path & "\folders\screenshots") 'make screenshots directory
  If directoryexists(App.Path & "\folders\bookmarks") = False Then Call MkDir(App.Path & "\folders\bookmarks") 'make bookmarks directory
  If directoryexists(App.Path & "\folders\temporary") = False Then Call MkDir(App.Path & "\folders\temporary") 'make temporary directory
  If directoryexists(App.Path & "\folders\pro action replay") = False Then Call MkDir(App.Path & "\folders\pro action replay") 'make par directory

  ggcontroller = 255& 'gg controller default
  StateSlot = 0 'current save slot
  MovieSlot = 0 'current movie slot
  MoviePlaying = False 'no movie playing
  MovieRecording = False 'no movie recording
  Layerdrawbg = True 'draw bg layer
  LayerDrawSprites = True 'draw sprites layer
  steppy = False 'for frame advancing
  frame_two_rom = True

  For X = 0& To 65535 'Calculate Div \ 256.
    glMemAddrDiv256(X) = (X \ 256&)
  Next X

  For X = 0& To 255& 'Calculate Flag Parity.
    Y = True
    For Z = 0& To 7&
      If (X And (2& ^ Z)) <> 0& Then Y = Not Y
    Next Z
    Parity(X) = Y
  Next X

  For X = 1& To 600& 'Calculate Bit Shifts.
    Z = 2
    For Y = 1& To 10&
      ShiftRight(X, Y) = (X \ Z)
      ShiftLeft(X, Y) = (X * Z)
      Z = Z * 2
    Next Y
  Next X
  
  ReDim Mul4000(64) 'Calculate Page Lookup. Upto 1MB.
  For X = 0 To 64
    Mul4000(X) = X * Page1
  Next X

  With myBMP.bmiHeader 'SMS Screen Setup.
    .biWidth = SMS_WIDTH
    .biHeight = -SMS_HEIGHT
    .biSize = 40
    .biBitCount = 32
    .biPlanes = 1
  End With

  Call windowscale(Zoom_Size)

  Call frmSMS.Show

  If Command$ <> "" Then
    Call loadrom(Replace(Command$, Chr$(34), ""))
  End If

End Sub
Public Sub windowscale(f)

  frmSMS.Height = 0
  frmSMS.Width = 0
  
  Do
    frmSMS.Width = frmSMS.Width + 1
  Loop Until frmSMS.ScaleWidth = 256 * f
  
  Do
    frmSMS.Height = frmSMS.Height + 1
  Loop Until frmSMS.ScaleHeight = 192 * f
  
End Sub
Public Sub loadrom(url As String) 'Read a cartridge into memory.

  Dim X As Long, Y As Long, Z As Long, hash As String

  If fileexists(url$) = False Then Exit Sub 'checks if the file doesn't exist

  If LCase$(right$(url$, 3)) = "zip" Then 'checks if it's a zip file
    Dim oUnZip As CGUnzipFiles
    Set oUnZip = New CGUnzipFiles
    oUnZip.ZipFileName = url$ 'gets the filename
    oUnZip.ExtractDir = App.Path & "\folders\temporary\" 'sets the extraction directory
    Call oUnZip.unzip 'unzips it
    If fileexists(App.Path & "\folders\temporary\" & filenameextract(url$) & ".gg") = True Then url$ = App.Path & "\folders\temporary\" & filenameextract(url$) & ".gg" 'sets if it's gg
    If fileexists(App.Path & "\folders\temporary\" & filenameextract(url$) & ".sms") = True Then url$ = App.Path & "\folders\temporary\" & filenameextract(url$) & ".sms" 'sets if it's sms
    Set oUnZip = Nothing
  End If

  Open url For Binary As #1 'Read Cart into Memory.
  Y = LOF(1) 'Store File Length.
  Z = Y Mod &H4000& 'check if it has a header (first 512 bytes, if so, skip)
  number_of_pages = (Y / &H4000&) 'Calculate Number of Pages.
  ReDim pages(Y) 'Redim Paging Array Accordingly.
  Get #1, Z + 1, pages() 'Retrieve file data (header aware).
  Close #1

  Call compatibiltyhacks(getcrc32(pages))

  'Default ROM Mapping.
  If (Y >= &HC000&) Then Y = &HC000&
  Call CopyMemory(cartRom(0), pages(0), Y)

  ROM_Name$ = filenameextract$(url$) 'stores rom name for use with save state filenames, etc.

  frmSMS.Caption = "vbsms+ [" & LCase(ROM_Name$) & "]"

  If LCase$(right$(url$, 3)) = "sms" Then IsGameGear = False Else IsGameGear = True 'detects whether it's a SMS or GG game
  If MemoryEditorOpen = True Then Call BookmarksLoad 'checks if the memory editor's open and clears/loads bookmarks
  If PAROpen = True Then Call PARLoad 'checks if the par's open and clears/loads bookmarks
  If FullScreenOnROM Then Call frmSMS.mnuFullScreenToggle_Click 'checks whether to switch to full screen or not

  Call frmSMS.mnuReset_Click 'resets the SMS/GG
  Executing = True 'sets executing boolean operator
  Call z80.execute 'starts execution

End Sub
